home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol285 / creatmar.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-03-15  |  3.2 KB  |  109 lines
  1. 100  REM CREATMAR Program
  2. 110  REM Creates (Formats) a Marriages File
  3. 120  REM Copyright (c) 1983 - 1987 by: Melvin O. Duke.
  4. 130  DEFINT A-Z
  5. 600  REM Titles
  6. 610  TITLE$ = "Create a Marriages File"
  7. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  8. 700  REM Terminate if not called from the Menu
  9. 710  IF DD.MENU$ <> "" THEN 770
  10. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  11. 730  PRINT "Cannot run the"
  12. 740  PRINT TITLE$
  13. 750  PRINT "Program, unless selected from the MENU"
  14. 760  END
  15. 770  REM OK
  16. 1000  REM Produce the first screen
  17. 1010  KEY ON : CLS : KEY OFF
  18. 1020  REM Draw the outer double box
  19. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  20. 1040  REM Find the title location
  21. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  22. 1060  REM Draw the title box
  23. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  24. 1080  REM Print the title
  25. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  26. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  27. 1230  REM Draw the Copyright box
  28. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  29. 1250  REM Print the Copyright
  30. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  31. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  32. 1280  GOTO 1700
  33. 1300  REM subroutine to print a double box
  34. 1310  COLOR P
  35. 1320  FOR I = R1 + 1 TO R2 - 1
  36. 1330   LOCATE I, C1 : PRINT CHR$(186);
  37. 1340   LOCATE I, C2 : PRINT CHR$(186);
  38. 1350  NEXT I
  39. 1360   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  40. 1390   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
  41. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  42. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  43. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  44. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  45. 1440  COLOR W
  46. 1450  RETURN
  47. 1500  REM subroutine to print a single box
  48. 1510  COLOR B
  49. 1520  FOR I = R1 + 1 TO R2 - 1
  50. 1530   LOCATE I, C1 : PRINT CHR$(179);
  51. 1540   LOCATE I, C2 : PRINT CHR$(179);
  52. 1550  NEXT I
  53. 1560   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  54. 1590   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
  55. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  56. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  57. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  58. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  59. 1640  COLOR W
  60. 1650  RETURN
  61. 1700  REM ask user to press a key to continue
  62. 1710  LOCATE 25,1
  63. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  64. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  65. 1740  KEY ON : CLS : KEY OFF
  66. 1800  REM Give the User one more chance to protect himself.
  67. 1810  LOCATE 10,1
  68. 1820  PRINT "This program FORMATS a Marriages-file by writing new, empty records."
  69. 1830  PRINT "It will destroy any data which exists with the same record-numbers."
  70. 1840  PRINT
  71. 1850  PRINT "If this is REALLY what you want to do,"
  72. 1860  PRINT "type  y  to continue, and press the 'enter' key."
  73. 1870  PRINT "Otherwise, type anything else, and press the 'enter' key."
  74. 1880  PRINT
  75. 1890  LINE INPUT "Enter your desired action: ",REPLY$
  76. 1900  IF LEFT$(REPLY$,1) = "y" THEN 2000
  77. 1910  IF LEFT$(REPLY$,1) = "Y" THEN 2000
  78. 1920  PRINT
  79. 1930  PRINT "File was NOT Created."
  80. 1940  PRINT
  81. 1950  PRINT "Press any key to continue"
  82. 1960  A$ = INKEY$ : IF A$ = "" THEN 1960
  83. 1970  GOTO 2220  'to end the program
  84. 2000  REM CREATMAR Program Starts Here
  85. 2010  OPEN DD.MARR$+"marrfile" AS #2 LEN = 128
  86. 2020  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  87. 2030  '
  88. 2040  REM Write the Marriage Records
  89. 2050  FOR I = OLD.MAX.MAR + 1 TO MAX.MAR
  90. 2060   LOCATE 22,1 : PRINT "Writing Record:"; I
  91. 2070   TEMP! = -I
  92. 2080   LSET M1$ = MKS$(TEMP!)    'Record Number
  93. 2090   TEMP! = 0
  94. 2100   LSET M2$ = MKS$(TEMP!)    'Husband
  95. 2110   LSET M3$ = MKS$(TEMP!)    'Wife
  96. 2120   LSET M4$ = MKS$(TEMP!)    'Code
  97. 2130   TEMP$ = " "
  98. 2140   LSET M5$ = TEMP$          'Marriage Date
  99. 2150   LSET M6$ = TEMP$          'Marriage City
  100. 2160   LSET M7$ = TEMP$          'Marriage County
  101. 2170   LSET M8$ = TEMP$          'Marriage State
  102. 2180   LSET M9$ = TEMP$          'Comments
  103. 2190   PUT #2, I
  104. 2200  NEXT I
  105. 2210  CLOSE #2
  106. 2220  KEY ON : CLS : KEY OFF : LOCATE 21,1
  107. 2230  PRINT "End of Program"
  108. 2240  RUN DD.MENU$+"menu"
  109.